Garbo/Garbo.cdr/mac/hypercrd/xcmd/dxcmds34.sit/Dartmouth XCMD's 3.4.3/card_17742.txt

Text File | 1990-04-17 | 16KB | 460 lines

-- card: 17742 from stack: in.3
-- bmap block id: 0
-- flags: 4000
-- background id: 3241
-- name: ConvertDate
----- HyperTalk script -----
on Install
  get ChooseTargetStack()
  InstallResource XFCN,ConvertDate,it
end Install


-- part 1 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part 2 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=299 top=300 right=322 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show Pascal Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 1 to not the visible of card field 1
  if the visible of card field 1 is true then
    set the name of me to "Hide Pascal Source"
  else set the name of me to "Show Pascal Source"
end mouseUp



-- part 3 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=80 top=300 right=322 bottom=180
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Try It
----- HyperTalk script -----
on mouseUp
  ask "What is your birthday?"
  if it is not empty then
    put convertdate(it) into birthday
    if word 1 of birthday is not "Error" then
      get the date
      put convertdate(it) into today
      subtract birthday from today
      divide today by 60
      divide today by 60
      divide today by 24
      answer "Today is your" && today+1 & "th day.  Congratulations!"
    else
      answer "That doesn't make sense as a date."
    end if
  end if
end mouseUp



-- part contents for background part 16
----- text -----
CONVERTDATE XFCN version 1.0.1
Kevin Calhoun

ConvertDate performs a function identical to that of the HyperTalk "convert" command--it converts a date expressed in one of the standard HyperCard formats into another expression, in a specified format, for the same date.  (The standard formats for dates are defined on page 99 of the HyperCard Script Language Guide.)

The advantage of using ConvertDate rather than the HyperTalk command "convert" is that ConvertDate can recognize dates far beyond the range of those that HyperCard is currently capable of handling properly:  from January 1, 1904 to February 6, 2040.  ConvertDate relies on routines in the new version of the Script Manager that handle all dates within about 35 thousand years of January 1, 1904; however, there are other features of these Script Manager routines that limit the range more severely.  When converting dates in the dateItems format or the seconds format, ConvertDate will properly convert all dates falling between January 1 of the year 1 and December 31, 9999.  When converting dates in the long date, short date, or abbreviated date formats, ConvertDate works properly for dates from January 1, 1000 to December 31, 9999*.

ConvertDate recognizes the format of the input expression by itself, whether the format is seconds, dateItems, long date, short date, or abbreviated date.

WHAT IT'S GOOD FOR
ConvertDate is intended chiefly for those users who need to sort the cards of a stack by date.  Use ConvertDate to convert the dates to seconds format; then use the HyperTalk command "sort" to sort the stack.

ConvertDate is also useful for determining which day of the week it was when you were born, how many days have passed since July 4, 1776, and all that sort of thing.

INVOKING CONVERTDATE

get ConvertDate(inputExpression,<outputFormat>)

result:  a date in the format specified

The second parameter can be any of the standard date formats as defined on page 99 of the HyperCard Script Language Guide.  If there is no second parameter, or if it is something other than one of the standard formats, ConvertDate defaults to seconds.

EXAMPLES

get ConvertDate(card field 2,"abbr date")
get ConvertDate("Wednesday, March 15, 1989","dateItems")
get ConvertDate("1959,5,14,0,0,0,0","long date")  -- note that when using dateItems
                  format, it isn't necessary to enter the correct day of week

*  It is not yet clear to me whether the Script Manager routines that ConvertDate relies on take into account, in localized versions of the System Software, any or all of the historical twiddlings of the official calendar that apply or have applied to a given geographical region.  In other words, if you're attempting to calculate the interest owed on a longstanding loan made earlier than 1914 by your ancestors to the ancestors of a debtor, I recommend hiring a specialist.

Here is the reason that January 1, 1000 is the earliest date that can be converted successfully when expressed in long date, short date, or abbreviated date format:  the Script Manager routine String2Date adds 1900 to years earlier than 100, so that 1/1/75 means January 1, 1975, and 1000 to years earlier than 1000, so that 1/1/975 means the same as 1/1/75.  When using ConvertDate with an input date in dateItems format or seconds format, the XFCN doesn't call String2Date to interpret the input; therefore if you want to handle dates between January 1, 1, and January 1, 1000, you can ensure correctness by representing dates in dateItems format or seconds format and converting them to your preferred format for display purposes.  The range of the output year, 1 to 9999, is imposed by the Script Manager routine LongSecs2Date.

REVISION HISTORY
March 17, 1989 -- 1.0 release.
March 31, 1989 -- 1.0.1.  Fixed problem with dates input in short date format.  Input expression, if a container, should no long be quoted.


-- part contents for card part 1
----- text -----
UNIT ConvertDateUnit;

{ ConvertDate XFCN ©1989 by the Trustees of Dartmouth College }
{ Written by Kevin Calhoun }

{ This source compatible with MPW Pascal 3.0 }

(*
pascal ConvertDate.p
Link -m ENTRYPOINT Γêé
     -o "YourFile" Γêé
     -rt XFCN=1904 Γêé
     -sg ConvertDate Γêé
     ConvertDate.p.o Γêé
    "{Libraries}"interface.o Γêé
    "{PLibraries}"Paslib.o Γêé
    "{PLibraries}"SANElib.o Γêé
    "{Libraries}"HyperXLib.o
*)

{$R-}

INTERFACE
  USES
    Types,
    Memory,
    Script,
    SANE,
    HyperXCmd;

  PROCEDURE EntryPoint (paramPtr : XCMDPtr);

IMPLEMENTATION

TYPE
  HCDateForm = (seconds, dateItems, lngDate, shrtDate,
    abbrvDate, lngTime, shrtTime, abbrvTime);

PROCEDURE ConvertDate(paramPtr: XCmdPtr); FORWARD;

PROCEDURE Entrypoint(paramPtr: XCmdPtr);
BEGIN
  ConvertDate(paramPtr);
END;

FUNCTION ScriptManagerInstalled: BOOLEAN;
  const
    UnimplCoreRoutine = $9F;
    ScriptUtil = $B5;
BEGIN
  ScriptManagerInstalled :=
    GetTrapAddress(UnimplCoreRoutine) <> GetTrapAddress(ScriptUtil);
END;

PROCEDURE PassReturnValue(paramPtr: XCMDPtr; s: Str255);
BEGIN
  paramPtr^.returnValue := PasToZero(paramPtr, s);
END;

FUNCTION CommaCount(str: Str255): INTEGER;
{ How many commas are in a string? }
  VAR
    count,i: INTEGER;
BEGIN
  count := 0;
  FOR i := 1 to LENGTH(str) DO
    IF str[i] = ',' THEN count := count+1;
  CommaCount := count;
END;

FUNCTION IsDateItems(paramPtr: XCMDPtr; hndl: Handle): BOOLEAN;
{ Determine whether h contains a comma-separated list of 7 items. }
  VAR
    str: Str255;
BEGIN
  ZeroToPas(paramPtr, hndl^, str);
  IsDateItems := (CommaCount(str)=6);
END;

PROCEDURE GetNextItem(sPtr: StringPtr; var index: INTEGER;
                     var item: Str255);
{ Scan a string from position index until the next comma, or until
  the end of the string, and return the characters we collected
  in item. }
  VAR
    start: INTEGER;
    sLength: INTEGER;
BEGIN
  sLength := LENGTH(sPtr^);
  IF index <= sLength THEN
    BEGIN
    start := index;
    WHILE (sPtr^[index] <> ',') AND (index < sLength) DO index := index+1;
    IF sPtr^[index] = ',' THEN index:=index-1;
    item := COPY(sPtr^, start, (index-start+1));
    index := index+2;
    END;
END;

PROCEDURE Handle2LongDate(paramPtr: XCMDPtr; h: Handle; VAR dateTime: LongDateRec);
{ convert a comma-separated list in h into a LongDateRec }
  VAR
    str: Str255;
    i,index: INTEGER;
    stringPtr: Ptr;
    numStr: Str255;
    return: Handle;
    num: INTEGER;
BEGIN
  ZeroToPas(paramPtr, h^, str);
  index := 1;
  dateTime.list[0] := 0;
  for i := 1 to 7 do
    begin
    GetNextItem(@str,index,numStr);
    num := StrToNum(paramPtr, numStr);
    dateTime.list[i] := num;
    end;
  for i := 8 to 13 do dateTime.list[i] := 0;
END;

FUNCTION IsANumber(paramPtr: XCMDPtr; h: Handle): BOOLEAN;
{ call SANE to determine if h contains a valid number }
  VAR
    s: Str255;
    index: INTEGER;
    d: decimal;
    validPrefix: BOOLEAN;
    c: Comp;
    n: NumClass;
BEGIN
  IsANumber := FALSE;
  ZeroToPas(paramPtr, h^, s);
  index := 1;
  Str2Dec(DecStr(s), index, d, validPrefix);
  IF validPrefix AND (index = LENGTH(s) + 1) THEN
    BEGIN
    c := Dec2Num(d);
    n := ClassComp(c);
    CASE n OF
      ZeroNum,NormalNum: IsANumber := TRUE;
      END;
    END;
END;

PROCEDURE CompToString(c: Comp; var s: Str255);
{ call SANE to convert our LongDateTime to a string }
  VAR
    f: decform;
BEGIN
  with f do
    begin
    style := FixedDecimal;
    digits := 0;
    end;
  Num2Str(f, c, DecStr(s));
END;

PROCEDURE Handle2Comp(paramPtr: XCMDPtr; h: Handle; var c: Comp);
{ call HyperCard to turn h into a string, and then
  call SANE to turn the string into a Comp }
  VAR
    s: DecStr;
BEGIN
  ZeroToPas(paramPtr, h^, Str255(s));
  c := Str2Num(s);
END;

PROCEDURE DateItems2Str(paramPtr: XCMDPtr; lDate: LongDateRec; var s: Str255);
{ convert our LongDateRec to a HyperCard comma-separated list }
  VAR
    j: INTEGER;
    num: Str255;
BEGIN
  s := '';
  for j := 1 to 7 do
    begin
    NumToStr(paramPtr, lDate.list[j], num);
    s := CONCAT(s, num, ',');
    end;
  DELETE(s, LENGTH(s), 1);
END;

FUNCTION GetHCDateForm(paramPtr: XCMDPtr): HCDateForm;
{ grab parameter 2, which determines the format into which we convert
  parameter 1 }
VAR
  s: Str255;
BEGIN
  IF paramPtr^.paramCount > 1 THEN
    BEGIN
    ZeroToPas(paramPtr, paramPtr^.params[2]^, s);
    IF EqualString(s, 'seconds', FALSE, TRUE) THEN
      GetHCDateForm := seconds
    ELSE IF EqualString(s, 'dateItems', FALSE, TRUE) THEN
      GetHCDateForm := dateItems
    ELSE IF EqualString(s, 'long date', FALSE, TRUE) THEN
      GetHCDateForm := lngDate
    ELSE IF EqualString(s, 'short date', FALSE, TRUE) THEN
      GetHCDateForm := shrtDate
    ELSE IF EqualString(s, 'abbreviated date', FALSE, TRUE) OR
            EqualString(s, 'abbrev date', FALSE, TRUE) OR
            EqualString(s, 'abbr date', FALSE, TRUE) THEN
      GetHCDateForm := abbrvDate
    ELSE GetHCDateForm := seconds;
    END
  ELSE GetHCDateForm := seconds;
END;

PROCEDURE ZeroDateTime(var dateTime: LongDateRec);
{ put zeros everywhere in the LongDateRec --
  the ScriptManager documentation says to be careful, so... }
  VAR j: INTEGER;
BEGIN
  for j := 0 to 13 do dateTime.list[j] := 0;
END;

PROCEDURE ZeroTime(var dateTime: LongDateRec);
{ ...we'll zero irrelevant stuff again after the
  LongDateRec is returned from String2Date }
  VAR j: INTEGER;
BEGIN
  dateTime.era := 0;
  for j := 4 to 6 do dateTime.list[j] := 0;
  for j := 8 to 13 do dateTime.list[j] := 0;
END;

PROCEDURE ConvertDate(paramPtr: XCmdPtr);
TYPE
  DateCacheHandle = ^DateCachePtr;
VAR
  smVers: LONGINT;
  s: Str255;
  h: Handle;
  myCacheHandle: DateCacheHandle;
  hLength, lengthUsed: LONGINT;
  dateTime: LongDateRec;
  lSecs: LongDateTime;
  form: HCDateForm;
  dateStr: Str255;
  err: OSErr;

BEGIN
  err := noErr;
  { we need input }
  IF paramPtr^.paramCount > 0 then
    BEGIN
    { check whether the Script Manager is available }
    IF ScriptManagerInstalled THEN
      BEGIN
      { now we check whether Script Manager 2.0 or greater is around }
      smVers := GetEnvirons(smVersion);
      if smVers >= $0200 THEN
        BEGIN
        { we get the input expression }
        h := paramPtr^.params[1];
        err := 0;
        MoveHHi(h);
        HLock(h);
        { we create a DateCacheRecord in the heap and initialize it }
        myCacheHandle := DateCacheHandle(NewHandleClear(SIZEOF(DateCacheRecord)));
        err := MemError;
        if err = noErr then
          begin
          MoveHHi(Handle(myCacheHandle));
          HLock(Handle(myCacheHandle));
          err := InitDateCache(myCacheHandle^);
          if err = noErr then
            begin
            ZeroDateTime(dateTime);
            IF IsDateItems(paramPtr, h) THEN
              BEGIN
            { input was in dateItems format;  we'll parse it ourselves }
              Handle2LongDate(paramPtr, h, dateTime);
            { we'll pull the old in-and-out to make sure
              we have the right dayOfWeek in our LongDateRec }
              LongDate2Secs(dateTime, lSecs);
              LongSecs2Date(lSecs, dateTime);
              END
            ELSE IF IsANumber(paramPtr, h) THEN
              BEGIN
              Handle2Comp(paramPtr, h, lSecs);
              LongSecs2Date(lSecs, dateTime);
              END
            ELSE
              BEGIN
            { we'll let String2Date parse the input }
              lengthUsed := 0;
              hLength := StringLength(paramPtr, h^);
            { call the Script Manager to convert our
              input expression to a LongDateRec }
              err := OSErr(String2Date(h^, hLength,
                  myCacheHandle^, lengthUsed, dateTime));
            { we'll pull the old in-and-out to make sure
              we have the right dayOfWeek in our LongDateRec }
              IF err in [0..64] then
                BEGIN
                ZeroTime(dateTime);
                LongDate2Secs(dateTime, lSecs);
                LongSecs2Date(lSecs, dateTime);
                END;
              END;
            if (err in [0..64]) then
              begin
              err := noErr;
              { get second param, which tells us what
                the output format should be... }
              form := GetHCDateForm(paramPtr);
              { ...and convert according to that form }
              CASE form OF
                seconds: CompToString(lSecs, dateStr);
                dateItems: DateItems2Str(paramPtr, dateTime, dateStr);
                lngDate: IULDateString(lSecs, longDate, dateStr, nil);
                shrtDate: IULDateString(lSecs, shortDate, dateStr, nil);
                abbrvDate: IULDateString(lSecs, abbrevDate, dateStr, nil);
                end;
              PassReturnValue(paramPtr, dateStr);
              end;  { input was parsed OK or considered a comp }
            end;  { date cache initialized OK }
          DisposHandle(Handle(myCacheHandle));
          end;  { myCacheHandle initialized OK }
        HUnlock(h);
        IF err <> noErr then
          begin
          NumToStr(paramPtr, err, s);
          PassReturnValue(paramPtr, CONCAT('Error ', s));
          end;
        END  { script manager 2.0 or later present }
      else PassReturnValue
        (paramPtr, 'Error -- ConvertDate requires Script Manager 2.0 or greater.');
      END  { script manager installed }
    else PassReturnValue(paramPtr, 'Error -- Script Manager not installed.');
    END  { we had at least 1 parameter }
  else PassReturnValue(paramPtr, 'ConvertDate XFCN 1.0.1, 31 March 1989, ©1989 Dartmouth College');
END;

END.